home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_scroll < prev    next >
Encoding:
Text File  |  1991-12-30  |  2.5 KB  |  96 lines
  1. \ Demonstrate scrolling by calling graphics library.
  2. \
  3. \ Author: Phil Burk
  4. \ Copyright 1986  Delta Research
  5.  
  6. include? newwindow.setup ju:amiga_graph
  7. include? ?closebox ju:amiga_events
  8. include? choose ju:random
  9.  
  10. ANEW TASK-DEMO_SCROLL
  11.  
  12. \ Example of calling AMIGA graphics library.
  13. : SCROLLRASTER ( rp dx dy xmin ymin xmax ymax -- , scroll region )
  14.     call graphics_lib ScrollRaster drop
  15. ;
  16.  
  17. \ Example of acessing AMIGA structure.
  18. : WINDOWLIMITS? ( -- w h , access window structure for x,y limits )
  19.     gr-curwindow @ ..@ wd_width
  20.     gr-curwindow @ ..@ wd_height
  21. ;
  22.  
  23. \ Variables for tracking curtain position.
  24. VARIABLE CURT-YMAX
  25. VARIABLE CURT-XMAX
  26. VARIABLE CURT-LEFT
  27. VARIABLE CURT-RIGHT
  28.  
  29. : SPREAD.CURTAIN ( #pixels -- , Split window in middle. )
  30.     gr-currport @ over 0  ( Scroll left hand side. )
  31.     0  0    curt-left @  curt-ymax @   ScrollRaster
  32. \
  33.     gr-currport @ over negate  0  ( Then right side. )
  34.     curt-right @  0    curt-xmax @  curt-ymax @   ScrollRaster
  35. \
  36.     dup curt-right +!   negate curt-left +!  ( Update curtain position.)
  37. ;
  38.  
  39. : MEASURE.WINDOW  ( -- , Setup variables for scrolling. )
  40.     WindowLimits? curt-ymax !
  41.     dup curt-xmax !
  42.     2/ dup curt-left ! curt-right !
  43. ;
  44.  
  45. : DRAW.GAP  ( -- , Draw four lines inside gap between curtains. )
  46. \ Cycle colors.
  47.     gr.color@ 1+ 3 AND
  48.     dup gr.bcolor@ =  ( Don't draw lines the same as background color )
  49.     IF 1+ 3 AND THEN
  50.     gr.color!
  51. \
  52. \ Draw four lines in bounds within gap.
  53.     curt-left @      curt-ymax @ choose gr.draw ( left )
  54.     curt-right @ curt-left @ wchoose 0 gr.draw ( top )
  55.     curt-right @     curt-ymax @ choose gr.draw ( right )
  56.     curt-right @ curt-left @ wchoose curt-ymax @ gr.draw ( bottom )
  57. ;
  58.  
  59. : PULL.CURTAIN ( -- , Pull curtain apart. )
  60.     measure.window
  61.     curt-left @  curt-ymax @ 2/ gr.move
  62.     0 gr.bcolor!
  63.     BEGIN
  64.         50 0 DO
  65.             1 spread.curtain
  66.             draw.gap
  67.             curt-left @ 6 <  ( At edge? )
  68. \ Restart curtain in current center of window.
  69.             IF  measure.window
  70.                 gr.bcolor@ 1+ 4 mod gr.bcolor! ( change background )
  71.             THEN
  72.         LOOP
  73.         ?closebox
  74.     UNTIL
  75. ;
  76.  
  77. NewWindow NewCurtain   ( Create a template for the new window. )
  78.  
  79. : CURTAINS  ( -- , Demonstrate scrollraster. )
  80.     gr.init
  81.     NewCurtain NewWindow.Setup   ( Set defaults for window )
  82. \
  83. \ The address of the title string must be converted to absolute
  84. \ addressing for use by the Amiga operating System.
  85.     0" Curtains!" >abs NewCurtain ..! nw_title ( change title )
  86. \
  87. \ Create window from template and make it the current window.
  88.     NewCurtain gr.opencurw
  89.     IF  pull.curtain
  90.         gr.closecurw
  91.     THEN
  92.     gr.term
  93. ;
  94.  
  95. cr ." Enter:   CURTAINS     for demo!" cr
  96.